home *** CD-ROM | disk | FTP | other *** search
/ PCMania 73 / PCMania CD73_1.iso / pcmania / demosc73 / CFADE.PAS < prev    next >
Pascal/Delphi Source File  |  1998-09-30  |  3KB  |  141 lines
  1.  
  2. { HEY! PcManíacos:                                               }
  3.  
  4. { Si queréis contactar con el autor de esta sección,             }
  5. { ahora podéis hacerlo a través de su e-mail privado:            }
  6.  
  7. { Miquel Barceló: (Demoscene)                                    }
  8. {                               e-mail: MBarceloJ@nexo.es        }
  9.  
  10. { -------------------------------------------------------------- }
  11.  
  12.  
  13. {$N+,E+}
  14.  
  15. uses dos,crt,graf;
  16.  
  17. var
  18.    mixtable : pointer;
  19.    pant1    : pointer;
  20.    pant2    : pointer;
  21.    pal1     : paleta;
  22.    pal2     : paleta;
  23.    palg     : paleta;
  24.    conta    : word;
  25.  
  26.  
  27. Procedure Grey_scale (var pant;pal :paleta);
  28. var
  29.    cont           : word;
  30.    spant,opant    : integer;
  31.    col            : byte;
  32.  
  33. begin
  34.      spant:=seg(pant);
  35.      opant:=ofs(pant);
  36.  
  37.      for cont:=0 to 63999 do
  38.      begin
  39.           col:=MEM[spant:opant+cont];
  40.           MEM[spant:opant+cont]:=4*(pal[col].r+pal[col].g+pal[col].b)div 3;
  41.      end;
  42.  
  43. end;
  44.  
  45. Procedure Calc_mixtable (factor: word);
  46. var
  47.    xc,yc        : word;
  48.    pos          : word;
  49.    smix,omix    : word;
  50.    temp         : word;
  51.  
  52. begin
  53.      smix:=seg(mixtable^);
  54.      omix:=ofs(mixtable^);
  55.      pos:=0;
  56.  
  57.      for yc:=0 to 255 do
  58.      begin
  59.           temp:=(256-factor)*yc;
  60.           for xc:=0 to 255 do
  61.           begin
  62.                MEM[smix:omix+pos]:=temp shr 8;
  63.                pos:=pos+1;
  64.                temp:=temp+factor;
  65.           end;
  66.      end;
  67.  
  68. end;
  69.  
  70. Procedure crossfade (var pant1, pant2);
  71. var
  72.    cont                : word;
  73.    smix,spant1,spant2,
  74.    omix,opant1,opant2  : word;
  75.  
  76. begin
  77.      smix:=seg(mixtable^);
  78.      omix:=ofs(mixtable^);
  79.      spant1:=seg(pant1);
  80.      opant1:=ofs(pant1);
  81.      spant2:=seg(pant2);
  82.      opant2:=ofs(pant2);
  83.  
  84.      for cont:=0 to 63999 do
  85.      MEM[$a000:cont]:=MEM[smix:omix+(MEM[spant1:opant1+cont] shl 8)+
  86.                                      MEM[spant2:opant2+cont]];
  87. end;
  88.  
  89. begin
  90.      getmem (pant1,64000);
  91.      getmem (pant2,64000);
  92.      getmem (mixtable,65535);
  93.  
  94.      set_vga;
  95.  
  96.      for conta:=0 to 255 do
  97.      begin
  98.           palg[conta].r:=conta shr 2;
  99.           palg[conta].g:=conta shr 2;
  100.           palg[conta].b:=conta shr 2;
  101.      end;
  102.  
  103.  
  104.      load_pcx('pcmania.pcx',pant1^);
  105.      getpaleta(pal1);
  106.      load_pcx('test.pcx',pant2^);
  107.      getpaleta(pal2);
  108.      flip (pant2^,vga^);
  109.  
  110.      readkey;
  111.      Grey_scale(pant1^,pal1);
  112.      Grey_scale(pant2^,pal2);
  113.      putpaleta(palg);
  114.  
  115.      flip (pant2^,vga^);
  116.      readkey;
  117.  
  118.  
  119.      repeat
  120.            conta:=0;
  121.            repeat
  122.                  inc (conta);
  123.                  calc_mixtable(256*conta div 50);
  124.                  crossfade(pant2^,pant1^);
  125.            until (keypressed) or (conta=50);
  126.            conta:=0;
  127.            repeat
  128.                  inc (conta);
  129.                  calc_mixtable(256*conta div 50);
  130.                  crossfade(pant1^,pant2^);
  131.            until (keypressed) or (conta=50);
  132.  
  133.      until keypressed;
  134.      readkey;
  135.      set_text;
  136.      freemem (pant1,64000);
  137.      freemem (pant2,64000);
  138.  
  139. end.
  140.  
  141.